perm filename PROGS.SAI[11,HE]2 blob
sn#626804 filedate 1981-12-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "disk image copy program" comment DCOPY.SAI
C00009 00003 BEGIN comment PTREAD.SAI
C00010 00004 BEGIN comment PUMA.SAI
C00019 00005 BEGIN "FTP Program Image mode only 10→11" comment IFTP.SAI
C00025 00006 Compute a checksum for a file, for FTP checking or quicky BINCOM
C00029 ENDMK
C⊗;
BEGIN "disk image copy program" comment DCOPY.SAI;
DEFINE CRLF="('15&'12)",
! = "COMMENT ",
TIL="STEP 1 UNTIL";
REQUIRE "11UTIL.HDR[11,SYS]" SOURCE_FILE;
DEFINE buflen = "'6000";
INTEGER bufadr,cyl,chan,brk,eof,cnt,flg,drv,sum,tmp,i,ck1,op;
SAFE INTEGER ARRAY foo[1:buflen];
STRING fname,s;
alinit;
chan ← getchan;
OPEN(chan,"DSK",'17,17,17,cnt,brk,eof);
WHILE TRUE DO BEGIN "loop"
PRINT("Read or Write (R/W): "); op ← IF (INCHWL LOR '40)="w" THEN TRUE ELSE FALSE;
PRINT("Disk name: "); fname ← inchwl; IF fname = NULL THEN CALL(0,"EXIT");
PRINT("Drive number: "); drv ← CVD(INCHWL);
POKE('1002,drv); ! Tell 11 which drive to use;
IF op THEN
BEGIN ! Get ready to Write out;
LOOKUP(chan,fname&".RSX",flg);
IF flg THEN BEGIN PRINT("Can't find file - aborted"&crlf); CONTINUE END;
PRINT("Type Y to confirm the write: "); IF (INCHWL LOR '40)≠"y" THEN CONTINUE;
POKE('1004,2); ! Tell 11 to start writing;
PRINT(crlf&"Starting write of: ",fname,crlf&" cyl: ");
SUM ← 0;
FOR cyl ← 1 TIL 203 DO
BEGIN
ARRYIN(chan,foo[1],buflen); ! Read it from disk;
FOR i ← 1 TIL buflen DO ! Compute the checksum;
Begin
TMP ← SUM + (SUM lsh 1);
SUM ← (SUM lsh 6) + (TMP lsh 2) + TMP + foo[i]
End;
WHILE (bufadr←peek('1000))=0 DO CALL(0,"SLEEP"); ! Sleep for 1 tick;
IF bufadr LAND 1 THEN
BEGIN
PRINT("Disk Error while writing cylinder ",cyl-2,crlf);
CONTINUE "loop";
END;
POKEARRAY(bufadr,buflen,foo,TWRJ); ! Write the cylinder out;
POKE('1000,0); ! Tell 11 we're done with buffer;
IF (cyl MOD 20) = 0 THEN PRINT(cyl," ");
END;
WHILE (bufadr←peek('1000))=0 DO CALL(0,"SLEEP"); ! Check 2nd last cyl was ok;
IF bufadr LAND 1 THEN
BEGIN
PRINT("Disk Error while writing cylinder 202"&crlf);
CONTINUE;
END;
POKE('1000,0); ! Tell 11 we're done with buffer;
WHILE (bufadr←peek('1000))=0 DO CALL(0,"SLEEP"); ! Wait til 11 writes last cyl;
IF bufadr LAND 1 THEN
BEGIN
PRINT("Disk Error while writing cylinder 203"&crlf);
CONTINUE;
END;
POKE('1000,0); ! Tell 11 we're done with buffer;
CLOSE(chan);
ck1 ← sum;
PRINT(crlf&"Confirming the write" & crlf & " cyl: ");
END
ELSE
BEGIN
ENTER(chan,fname&".RSX",flg);
POKE('1004,1); ! Tell 11 to start reading;
PRINT(crlf&"Starting read of: ",fname,crlf&" cyl: ");
SUM ← 0;
FOR cyl ← 1 TIL 203 DO
BEGIN
WHILE (bufadr←peek('1000))=0 DO CALL(0,"SLEEP"); ! Sleep for 1 tick;
IF bufadr LAND 1 THEN
BEGIN
PRINT("Disk Error while reading cylinder ",cyl-1,crlf);
CONTINUE "loop";
END;
PEEKARRAY(bufadr,buflen,foo,TWRJ); ! Read the cylinder in;
POKE('1000,0); ! Tell 11 we're done with buffer;
ARRYOUT(chan,foo[1],buflen); ! Store it to disk;
FOR i ← 1 TIL buflen DO ! Compute the checksum;
Begin
TMP ← SUM + (SUM lsh 1);
SUM ← (SUM lsh 6) + (TMP lsh 2) + TMP + foo[i]
End;
IF (cyl MOD 20) = 0 THEN PRINT(cyl," ");
END;
CLOSE(chan);
ck1 ← sum;
PRINT(crlf&"Confirming the read" & crlf & " cyl: ");
END;
POKE('1004,1); ! Tell 11 to start re-reading;
SUM ← 0;
FOR cyl ← 1 TIL 203 DO
BEGIN
WHILE (bufadr←peek('1000))=0 DO CALL(0,"SLEEP"); ! Sleep for 1 tick;
IF bufadr LAND 1 THEN
BEGIN
PRINT("Disk Error while reading cylinder ",cyl,crlf);
CONTINUE "loop";
END;
PEEKARRAY(bufadr,buflen,foo,TWRJ); ! Read the cylinder in;
POKE('1000,0); ! Tell 11 we're done with buffer;
FOR i ← 1 TIL buflen DO ! Compute the checksum;
Begin
TMP ← SUM + (SUM lsh 1);
SUM ← (SUM lsh 6) + (TMP lsh 2) + TMP + foo[i]
End;
IF (cyl MOD 20) = 0 THEN PRINT(cyl," ");
END;
S ← "";
tmp ← abs(ck1);
While tmp neq 0 Do
Begin
S ← S & ("A" + (tmp mod 26));
tmp ← tmp div 26;
End;
IF ck1 = sum THEN PRINT(crlf & "Checksums match = ",S, " - Copy complete" & crlf)
ELSE
BEGIN
PRINT(crlf & "Checksums don't match - Error" & crlf);
S ← S & " ";
SUM ← abs(SUM);
While SUM neq 0 Do
Begin
S ← S & ("A" + (SUM mod 26));
SUM ← SUM div 26;
End;
PRINT(" The two checksums: ",S,crlf);
END;
END;
END;
BEGIN comment PTREAD.SAI;
INTEGER PTRCHN,DSKCHN,DUMMY,PTREOF,VAL;
STRING file;
PTRCHN ← GETCHAN;
OPEN(PTRCHN,"PTR",'10,'17,0,DUMMY,DUMMY,PTREOF);
DSKCHN ← GETCHAN;
OPEN(DSKCHN,"DSK",'10,0,'17,DUMMY,DUMMY,DUMMY);
PRINT("OUTPUT FILE NAME: "); FILE ← INCHWL;
ENTER(DSKCHN,FILE,DUMMY);
DO VAL ← WORDIN(PTRCHN) UNTIL VAL≠0; COMMENT EAT LEADING NULLS;
DO BEGIN
WORDOUT(DSKCHN,VAL);
VAL ← WORDIN(PTRCHN);
END UNTIL PTREOF;
CLOSE(DSKCHN);
END
BEGIN comment PUMA.SAI;
DEFINE CRLF="('15&'12)",
! = "COMMENT ",
TIL="STEP 1 UNTIL";
INTEGER ELFCHAN; ! Channel number for I/O to ELF;
EXTERNAL INTEGER _SKIP_;
DEFINE SGNEXT="'4000000"; ! extend sign bit of input data ;
DEFINE OWPW ="0"; ! word for word transfer;
DEFINE TWRJ ="'1000000"; ! two words per word,right justified in each halfword;
DEFINE TWRM ="'2000000"; ! two words per word,in right most 32 bits;
DEFINE TWLM ="'3000000"; ! two words per word,in left most 32 bits;
! PEEK, POKE, PEEKARRAY, POKEARRAY, ALINIT;
SIMPLE INTEGER PROCEDURE CALLU0(STRING UUO;INTEGER AC;REFERENCE INTEGER ADDR);
BEGIN
INTEGER UUOCODE;
UUOCODE←CALL(CVSIX(UUO),"CALLIT");
IF UUOCODE=0 THEN PRINT("NO SUCH UUO: ",UUO)
ELSE RETURN(CODE(UUOCODE+(AC LSH 23),ADDR));
END;
SIMPLE INTEGER PROCEDURE IOWD(INTEGER N,LOC);
RETURN(((-N)LAND '777777)LSH 18 +(LOC-1));
INTEGER MTAPE_PLUS_ELF;
DEFINE ELFMTAPE(ADDR)="CODE(MTAPE_PLUS_ELF,ADDR)";
! peek,poke and peekarray take the actual address on the unibus;
INTEGER PROCEDURE PEEK(INTEGER ADR);
BEGIN "peek" ! Returns the ELF word at unibus address ADR;
INTEGER ARRAY A[1:2];
DEFINE PEEK = "'002000000000";
A[1]←PEEK+(ADR LSH -1);
! CALLU0("MTAPE",ELFCHAN,A[1]);
ELFMTAPE(A[1]);
IF NOT _SKIP_ THEN USERERR(0,1,"Couldn't peek at ELF");
RETURN(A[2]);
END "peek";
PROCEDURE POKE(INTEGER ADR, CONTENTS);
BEGIN "poke" ! Stores CONTENTS at unibus address ADR;
DEFINE POKE = "'003000000000";
INTEGER ARRAY A[1:2];
A[1]←POKE+(ADR LSH -1);
A[2]←CONTENTS;
! CALLU0("MTAPE",ELFCHAN,A[1]);
ELFMTAPE(A[1]);
IF NOT _SKIP_ THEN USERERR(0,1,"Couldn't poke at ELF");
END "poke";
PROCEDURE POKEARRAY(INTEGER ADR, LTH; INTEGER ARRAY CONTENTS; INTEGER USETBITS(0));
BEGIN "pokearray" ! Sends the CONTENTS[1:LTH] to unibus address ADR
and higher;
INTEGER USETO_WORD,SNDIOWD;
USETO_WORD←'400010400000 + (ADR LSH -1)+USETBITS;
CALLU0("USETO",ELFCHAN,USETO_WORD);
SNDIOWD←IOWD(LTH,LOCATION(CONTENTS[1]));
CALLU0("OUT",ELFCHAN,SNDIOWD);
IF _SKIP_ THEN USERERR(0,1,"POKEARRAY failed");
END "pokearray";
PROCEDURE PEEKARRAY(INTEGER ADR, LTH; INTEGER ARRAY CONTENTS; INTEGER USETBITS(0));
BEGIN "peekarray" ! Gets the CONTENTS[1:LTH] from unibus address ADR
and higher;
INTEGER USETI_WORD,GETIOWD;
USETI_WORD←'400010400000 +(ADR LSH -1)+USETBITS;
CALLU0("USETI",ELFCHAN,USETI_WORD);
GETIOWD←IOWD(LTH,LOCATION(CONTENTS[1]));
CALLU0("IN",ELFCHAN,GETIOWD);
IF _SKIP_ THEN USERERR(0,1,"PEEKARRAY failed");
END "peekarray";
INTERNAL PROCEDURE ALINIT;
BEGIN "init"
INTEGER COUNT, BRCHAR, EOF, FLAG;
INTEGER I;
! Initialize the ELF for output;
! '400 on in mode word and EOF←1 to take silent return if not available;
EOF←1;
OPEN(ELFCHAN←GETCHAN,"ELF",'417,0,0,COUNT,BRCHAR,EOF);
IF EOF THEN BEGIN PRINT("ELF is not available."); CALL(0,"EXIT") END;
MTAPE_PLUS_ELF←'072000000000+(ELFCHAN LSH 23);
END "init";
! program to talk to PUMA from 10 via DZ11;
INTEGER line,i,j,char,idle;
! DZ11 definitions;
DEFINE DZCSR = "'760000"; ! Control and Status register;
DEFINE DZLPR = "'760002"; ! Line Parameter register (write only);
DEFINE DZRBUF = "'760002"; ! Receiver Buffer register (read only);
DEFINE DZTCR = "'760004"; ! Transmitter Control register (byte);
DEFINE DZTBUF = "'760006"; ! Transmitter Buffer (byte, write only);
PROCEDURE DZINIT; ! Set up the DZ11 using line # in LINE;
BEGIN
INTEGER i;
POKE(DZCSR,'20); ! Reset DZ11;
CALL(0,"SLEEP"); ! Sleep for 1 tick;
i ← '12430 + line; ! Line parameters: 300 baud, 8 char, no parity;
POKE(DZLPR,i); ! Tell DZ11 what parameters to use;
i ← 1 LSH line; ! Set up transmit bit for line we're using;
POKE(DZTCR,i); ! Turn on transmit for line;
POKE(DZCSR,'40); ! Turn on master scan enable;
END;
alinit;
PRINT(crlf & "PUMA Terminal program"&crlf&crlf);
! PRINT("Which line do you want? (0-7): ");
line ← 0; ! CVD(INCHWL) LAND 7;
define ctlv = "'047000400001";
define setact = "'051640000000";
quick_code
label tab,xit;
ctlv ; ! this turns on the no echo bit;
hrlzi 1,tab;
setact 1; ! get old activation table;
hrrzi 1,tab;
hrrzi 2,'20;
iorm 2,3(1); ! make bs activate;
setact 1; ! make new table;
jrst xit;
tab: 0;0;0;0;
xit:
end;
DZINIT;
WHILE TRUE DO
BEGIN ! Now talk;
IF (char ← INCHRS) ≥ 0 AND char≠'12 THEN
BEGIN ! Send char to PUMA;
DO i ← PEEK(DZCSR) UNTIL i LAND '100000; ! Wait til transmitter ready;
IF ¬(i LAND '40) THEN DZINIT; ! DZ11 zapped, re-enable it;
char ← char LAND '177;
POKE(DZTBUF,char);
idle ← 0;
END;
j ← PEEK(DZRBUF); ! Anything to write?;
IF j LAND '100000 THEN
BEGIN ! Write char from PUMA;
j ← j LAND '177;
IF j = '10 THEN j ← '177; ! Convert ASCII bs to null;
IF j ≠ '26 THEN OUTCHR( j ); ! Don't print ⊗ from VAL;
idle ← 0;
END;
IF idle THEN CALL(0,"SLEEP"); ! Sleep for 1 tick;
idle ← idle + 1;
IF idle = 20000 THEN PRINT(crlf & "Are you still there???" & crlf);
IF idle ≥ 36000 THEN
BEGIN
PRINT("Auto-exit!!!" & crlf);
POKE(DZCSR,'20); ! Reset DZ11;
CALL(0,"EXIT");
END;
END;
END;
BEGIN "FTP Program Image mode only 10→11" comment IFTP.SAI;
DEFINE CRLF="('15&'12)",
CR ="'15",
LF ="'12",
! = "COMMENT ",
TIL="STEP 1 UNTIL";
REQUIRE "11UTIL.HDR[11,SYS]" SOURCE_FILE;
DEFINE TTYSET = "'047000400121";
DEFINE GETLIN = "'051300000000";
INTEGER chan; ! Channel number for I/O to RSX;
INTEGER dskchan; ! Channel number for 10 disk I/O;
EXTERNAL INTEGER _SKIP_;
INTEGER ARRAY buffer[1:256];
INTEGER talk10,char,i,j,k,l,brk,dum,eof,base,bufadr,bufptr;
STRING s,f1,fnam10,fext10,ppn10;
LABEL fin;
PROCEDURE parse10 (STRING s);
BEGIN
fnam10 ← fext10 ← NULL;
WHILE s=" " ∧ s ≠ NULL DO dum ← LOP(s); ! Strip off leading blanks;
WHILE s≠"." ∧ s≠"[" ∧ s≠NULL DO fnam10 ← fnam10 & LOP(s); ! Build up file name;
WHILE s≠"[" ∧ s≠NULL DO fext10 ← fext10 & LOP(s); ! Build up file extension;
IF s="[" THEN ppn10 ← s; ! Set ppn if present;
END;
SETBREAK(1,crlf,NULL,"INS");
ALINIT(false); ! Assign the ELF, but don't care about ARM;
PRINT(crlf & "10-11 FTP Program"&crlf&crlf);
chan ← GETCHAN;
OPEN(chan,"TTY53",0,1,1,999,brk,dum);
QUICK_CODE
LABEL XIT,SETUP;
HRRI '13,SETUP; ! Command list to initialize the tty;
HRLI '13,-3; ! Number of commands;
TTYSET '13,0; ! Do it;
JRST XIT;
SETUP:
! '072453000001; ! Set TTY EXIST;
! '040453000005; ! Set tty speed = 1200 baud;
'001453000004; ! Set (XON &) NO ECHO;
'002453010000; ! Set TTY NO ARROW?;
'023453000001; ! Set TTY GAG;
XIT: END;
OUT(chan,"RUN FTP"&crlf);
WHILE INPUT(chan,1) = NULL DO ; ! Ignore echo from RSX;
WHILE (s←INPUT(chan,1)) = NULL ∨ s=">" DO ;
base ← CVO(s) LSH 6; ! Get address of Partition Base;
PRINT("Partition base = ",CVOS(base),crlf);
WHILE (s←INPUT(chan,1)) = NULL DO ;
bufptr ← CVO(s); ! Get address of buffer pointer;
PRINT("Buffer pointer = ",CVOS(bufptr),crlf);
bufptr ← base + bufptr;
dskchan ← GETCHAN;
OPEN(dskchan,"DSK",'10,19,0,0,0,eof);
WHILE TRUE DO ! Get file to ship over;
BEGIN
PRINT("*");
f1 ← INCHWL; ! Read file name;
IF f1 = NULL THEN
BEGIN
POKE(bufptr+4,0); ! Tell 11 we're finished;
CALL(0,"EXIT");
END;
PARSE10(f1);
LOOKUP(dskchan,fnam10 & fext10 & ppn10,i);
IF i THEN
BEGIN PRINT("ABORTED - Can't find:",fnam10,fext10,ppn10,crlf); GO TO fin END;
POKE(bufptr+2,1); ! Tell 11 we're ready to start;
FOR k ← 1 TIL 4 DO i ← WORDIN(dskchan); ! Skip over header words;
eof ← FALSE;
DO BEGIN ! Start transferring characters to the 11;
FOR i ← 1 STEP 2 UNTIL 255 DO ! Read in the next 256 words for the 11;
BEGIN
k ← WORDIN(dskchan); ! Get next 4 bytes;
j ← POINT(8,k,7);
buffer[i] ← LDB(j) + (ILDB(j) LSH 8); ! First word;
buffer[i+1] ← ILDB(j) + (ILDB(j) LSH 8); ! Second word;
END;
WHILE (bufadr←PEEK(bufptr))=0 DO CALL(0,"SLEEP"); ! Sleep for 1 tick;
IF bufadr LAND 1 THEN ! Something's wrong - abort;
BEGIN
PRINT("Error while writing file"&crlf);
GO TO fin;
END;
bufadr ← bufadr + base;
POKEARRAY(bufadr,256,buffer,0); ! Transfer the sector over;
POKE(bufptr,0); ! Tell 11 to write it out;
END UNTIL eof;
POKE(bufptr+2,0); ! Tell 11 we're all done;
fin:
CLOSE(dskchan);
END;
END;
Comment Compute a checksum for a file, for FTP checking or quicky BINCOM;
Comment program courtesy of ejg - snarfed from score;
Begin
Require "⊂⊃<>" Delimiters;
Define ! = ⊂Comment ⊃;
Define CRLF = ⊂('15&'12)⊃;
Define FF = ⊂('14)⊃;
Define TAB = ⊂('11)⊃;
Boolean IEOF;
Integer IBRCH, SBRCH, ACOUNT;
String IFILE, IDEV;
Procedure ASSERT(Value Boolean ASSERTION);
Begin
ACOUNT ← ACOUNT + 1;
If ASSERTION Then Return;
SETFORMAT(0,0);
OUTSTR("$$$$$$$$$$ Assertion #" & CVS(ACOUNT) & " failed." & CRLF);
USERERR(0,1,"≡≡≡≡≡")
End;
String Procedure CVDATE(Value Integer X);
Begin
Integer DAY, MONTH, YEAR;
DAY ← (X mod 31) + 1;
X ← X div 31;
MONTH ← (X mod 12) + 1;
X ← X div 12;
YEAR ← X + 64;
SETFORMAT(-2,0);
Return(CVS(DAY) & "-" &
"JanFebMarAprMayJunJulAugSepOctNovDec"[3*MONTH-2 for 3] &
"-" & CVS(YEAR) )
End;
Procedure OPENFILE;
Begin "OPENFILE"
Integer FLAG;
While true do
Begin
OUTSTR("File to checksum:"); IFILE ← INCHWL;
If length(IFILE) = 0 Then Done;
IDEV ← SCAN(IFILE,1,SBRCH);
If SBRCH = 0 Then Begin IFILE ← IDEV; IDEV ← "DSK" End;
IEOF ← 1;
OPEN(1,IDEV,'10,19,0,10000,IBRCH,IEOF);
If IEOF then FLAG ← 1 Else LOOKUP(1,IFILE,FLAG);
If FLAG Then OUTSTR("Can't open/lookup input file, try again." & CRLF)
Else Done;
End;
End "OPENFILE";
ACOUNT ← 0;
SETBREAK(1,":",null,"INS");
While true Do
Begin
Integer W1, SUM, TMP;
String S;
OPENFILE;
If length(IFILE) = 0 Then Done;
SUM ← 0;
FOR i ← 1 TIL buflen DO
Begin
TMP ← SUM + (SUM lsh 1);
SUM ← (SUM lsh 6) + (TMP lsh 2) + TMP + foo[i]
End;
SUM ← abs(SUM);
S ← "";
While SUM neq 0 Do
Begin
S ← S & ("A" + (SUM mod 26));
SUM ← SUM div 26;
End;
OUTSTR("Checksum: " & S & CRLF);
CLOSE(1);
End;
End